home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0067_Simple Multitasker.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  8KB  |  308 lines
  1. Unit Multi;
  2. {--------------------------------------------------------------------------------}
  3. {                                                                                }
  4. { Hilfsfunktionen zur quasi-Multitaskingverarbeitung unter Turbo Pascal          }
  5. {                                                                                }
  6. { (c) 1994 by Hegel Udo                                                          }
  7. {                                                                                }
  8. {--------------------------------------------------------------------------------}
  9. Interface
  10. {--------------------------------------------------------------------------------}
  11. Type
  12.   StartProc = Procedure;
  13. {--------------------------------------------------------------------------------}
  14. Procedure AddTask (Start : StartProc;StackSize : Word);
  15. Procedure Transfer;
  16. {--------------------------------------------------------------------------------}
  17. Implementation
  18. {--------------------------------------------------------------------------------}
  19. Uses
  20.   Dos;
  21. {--------------------------------------------------------------------------------}
  22. Type
  23.   TaskPtr   = ^TaskRec;
  24.   TaskRec   = Record
  25.     StackSize : Word;
  26.     Stack     : Pointer;
  27.     SPSave    : Word;
  28.     SSSave    : Word;
  29.     BPSave    : Word;
  30.     Next      : TaskPtr;
  31.   end;
  32. {--------------------------------------------------------------------------------}
  33. Const
  34.   MinStack = 1024;
  35.   MaxStack = 32768;
  36. {--------------------------------------------------------------------------------}
  37. Var
  38.   Tasks    : TaskPtr;
  39.   AktTask  : TaskPtr;
  40.   OldExit  : Pointer;
  41. {--------------------------------------------------------------------------------}
  42. Procedure AddTask (Start : StartProc;StackSize : Word);
  43. Type
  44.   OS = Record
  45.     O,S : Word;
  46.   end;
  47. Var
  48.   W  : ^TaskPtr;
  49.   SS : Word;
  50.   SP : Word;
  51. begin
  52.   W := @Tasks;
  53.   While Assigned (W^) do W := @W^^.Next;
  54.   New (W^);
  55.   if StackSize < MinStack then StackSize := MinStack;
  56.   if StackSize > MaxStack then StackSize := MaxStack;
  57.   W^^.StackSize := StackSize;
  58.   GetMem (W^^.Stack,StackSize);
  59.   SS := OS(W^^.Stack).S;
  60.   SP := OS(W^^.Stack).O+StackSize-4;
  61.   Move (Start,Ptr(SS,SP)^,4);
  62.   W^^.SPSave := SP;
  63.   W^^.SSSave := SS;
  64.   W^^.BPSave := W^^.SPSave;
  65.   W^^.Next := NIL;
  66. end;
  67. {--------------------------------------------------------------------------------}
  68. Procedure Transfer; Assembler;
  69. Asm
  70.   LES SI,AktTask                               { Alter Status sichern }
  71.   MOV ES:[SI].TaskRec.SPSave,SP
  72.   MOV ES:[SI].TaskRec.SSSave,SS
  73.   MOV ES:[SI].TaskRec.BPSave,BP
  74.   MOV AX,Word Ptr ES:[SI].TaskRec.Next         { Neue Task bestimmen }
  75.   OR  AX,Word Ptr ES:[SI].TaskRec.Next+2
  76.   JE  @InitNew
  77.   LES SI,ES:[SI].TaskRec.Next
  78.   JMP @DoJob
  79. @InitNew:
  80.   LES SI,Tasks
  81. @DoJob:
  82.   MOV Word Ptr AktTask,SI                      { Neue Task Sichern }
  83.   MOV Word Ptr AktTask+2,ES
  84.   CLI                                          { Status wieder hertstellen }
  85.   MOV SP,ES:[SI].TaskRec.SPSave
  86.   MOV SS,ES:[SI].TaskRec.SSSave
  87.   STI
  88.   MOV BP,ES:[SI].TaskRec.BPSave
  89. end;
  90. {--------------------------------------------------------------------------------}
  91. BEGIN
  92.   New (Tasks);              { Hauptprogramm als Task anmelden }
  93.   Tasks^.StackSize := 0;
  94.   Tasks^.Stack := NIL;
  95.   Tasks^.Next := NIL;
  96.   AktTask := Tasks;
  97. END.
  98.  
  99. { --------------------------   DEMO PROGRAM ---------------------- }
  100.  
  101. Program Multi_Demo;
  102.  
  103. Uses
  104.   DOS, Crt, Multi;
  105.  
  106. TYPE
  107.  
  108.       ScreenState = (free, used);          { Is screen position free? }
  109.       WindowType  = Record                 { Window descriptor }
  110.                       X,
  111.                       Y,
  112.                       Xsize,
  113.                       Ysize  : Integer;
  114.                     End;
  115.  
  116.  
  117. var   screen      : Array(.0..81,0..26.) of ScreenState;
  118.       WindowTable : Array(.1..20.) of WindowType;
  119.       i,j,                                 { Index variables }
  120.       NoWindows   : Integer;               { No. of windows on screen }
  121.  
  122. Procedure MakeWindow(X, Y, Xsize, Ysize: Integer; Heading: String);
  123.  
  124. { Reserves screenspace for window and draws border around it }
  125.  
  126.    const NEcorner = #187;                { Characters for double-line border }
  127.          SEcorner = #188;
  128.          SWcorner = #200;
  129.          NWcorner = #201;
  130.          Hor      = #205;
  131.          Vert     = #186;
  132.  
  133.    var   i,j : Integer;
  134.  
  135.    Begin
  136.      Window(1,1,80,25);
  137.  
  138.      { Reserve screen space }
  139.      For i:=X to X+Xsize-1 Do
  140.        For j:=Y to Y+Ysize-1 Do screen(.i,j.):=used;
  141.  
  142.      { Draw border - sides }
  143.      i:=X;
  144.      For j:=Y+1 to Y+Ysize-2 Do
  145.      Begin
  146.        GotoXY(i,j);
  147.        Write(Vert);
  148.      End;
  149.  
  150.      i:=X+Xsize-1;
  151.      For j:=Y+1 to Y+Ysize-2 Do
  152.      Begin
  153.        GotoXY(i,j);
  154.        Write(Vert);
  155.      End;
  156.  
  157.      j:=Y;
  158.      For i:=X+1 to X+Xsize-2 Do
  159.      Begin
  160.        GotoXY(i,j);
  161.        Write(Hor);
  162.      End;
  163.  
  164.      j:=Y+Ysize-1;
  165.      For i:=X+1 to X+Xsize-2 Do
  166.      Begin
  167.        GotoXY(i,j);
  168.        Write(Hor);
  169.      End;
  170.  
  171.      { Draw border - corners }
  172.      GotoXY(X,Y);
  173.      Write(NWcorner);
  174.      GotoXY(X+Xsize-1,Y);
  175.      Write(NEcorner);
  176.      GotoXY(X+Xsize-1,Y+Ysize-1);
  177.      Write(SEcorner);
  178.      GotoXY(X,Y+Ysize-1);
  179.      Write(SWcorner);
  180.  
  181.      { Make Heading }
  182.      GotoXY(X+(Xsize-Length(Heading)) div 2,Y);
  183.      Write(heading);
  184.  
  185.      { Save in table }
  186.      NoWindows:=NoWindows+1;
  187.      WindowTable(.NoWindows.).X:=X;
  188.      WindowTable(.NoWindows.).Y:=Y;
  189.      WindowTable(.NoWindows.).Xsize:=Xsize;
  190.      WindowTable(.NoWindows.).Ysize:=Ysize;
  191.  
  192.    End; { MakeWindow }
  193.  
  194. Procedure SelectWindow(i : Integer);
  195.  
  196.    { Specifies which window will receive subsequent output }
  197.  
  198.    Begin
  199.      With WindowTable(.i.) Do
  200.      Begin
  201.        Window(X+1,Y+1,X+Xsize-2,Y+Ysize-2);
  202.      End;
  203.    End; { SelectWindow }
  204.  
  205.  
  206. Procedure RemoveWindow(n: Integer);
  207.  
  208.    { Removes window number n }
  209.  
  210.    var i,j : Integer;
  211.  
  212.    Begin
  213.      SelectWindow(n);
  214.      With WindowTable(.n.) Do
  215.      Begin
  216.        Window(X,Y,X+Xsize,Y+Ysize);
  217.        For i:=X to X+Xsize Do
  218.          For j:=Y to Y+Ysize Do screen(.i,j.):=free;
  219.      End; { With }
  220.      ClrScr;
  221.    End; { SelectWindow }
  222.  
  223. Procedure Task1;Far;
  224. VAR
  225.     SR : SearchRec;
  226. begin
  227.   MakeWindow(27, 2,18,4,' Sub Task 1 ');
  228.   REPEAT
  229.     FINDFIRST('*.*',anyfile,SR);
  230.     WHILE DOSERROR = 0 DO
  231.           BEGIN
  232.           Transfer;
  233.           SelectWindow(2);
  234.           WriteLn(SR.Name : 12);
  235.           FINDNEXT(SR);
  236.           Delay(10);
  237.           END;
  238.   UNTIL FALSE;
  239. end;
  240.  
  241. Procedure Task2;Far;
  242. VAR
  243.     SR : SearchRec;
  244. begin
  245.   MakeWindow(27, 7,18,4,' Sub Task 2 ');
  246.   REPEAT
  247.     FINDFIRST('\TURBO\TP\*.*',anyfile,SR);
  248.     WHILE DOSERROR = 0 DO
  249.           BEGIN
  250.           Transfer;
  251.           SelectWindow(3);
  252.           WriteLn(SR.Name : 12);
  253.           FINDNEXT(SR);
  254.           Delay(10);
  255.           END;
  256.   UNTIL FALSE;
  257. end;
  258.  
  259. Procedure Task3;Far;
  260. VAR
  261.     SR : SearchRec;
  262. begin
  263.   MakeWindow(27,12,18,4,' Sub Task 3 ');
  264.   REPEAT
  265.     FINDFIRST('\TURBO\*.*',anyfile,SR);
  266.     WHILE DOSERROR = 0 DO
  267.           BEGIN
  268.           Transfer;
  269.           SelectWindow(4);
  270.           WriteLn(SR.Name : 12);
  271.           FINDNEXT(SR);
  272.           Delay(10);
  273.           END;
  274.   UNTIL FALSE;
  275. end;
  276.  
  277. Procedure Task4;Far;
  278. VAR
  279.     SR : SearchRec;
  280. begin
  281.   MakeWindow(27,17,18,4,' Sub Task 4 ');
  282.   REPEAT
  283.     FINDFIRST('\*.*',anyfile,SR);
  284.     WHILE DOSERROR = 0 DO
  285.           BEGIN
  286.           Transfer;
  287.           SelectWindow(5);
  288.           WriteLn(SR.Name : 12);
  289.           FINDNEXT(SR);
  290.           Delay(10);
  291.           END;
  292.   UNTIL FALSE;
  293. end;
  294.  
  295. BEGIN
  296.   ClrScr;
  297.   MakeWindow( 5,21,75,4,' Multi-Program Demo ');
  298.   SelectWindow(1);
  299.   WriteLn(' This is the MAIN task window and we will start 4 others too');
  300.   AddTask (Task1,8192);
  301.   AddTask (Task2,8192);
  302.   AddTask (Task3,8192);
  303.   AddTask (Task4,8192);
  304.   REPEAT
  305.     Transfer;
  306.   UNTIL KEYPRESSED;
  307. END.
  308.